home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Purity
/
Purity #23 (1994-02-10)(Diesel)(DE)[WB].zip
/
Purity #23 (1994-02-10)(Diesel)(DE)[WB].adf
/
OS_2_Beispiele
/
OS_Kurs1.p
< prev
next >
Wrap
Text File
|
1994-01-20
|
7KB
|
181 lines
PROGRAM OS_Zwei_Beispiel;
{ Beispiel zur GadTools-Library. }
{ ©1993 by Björn Schotte - FREEWARE }
USES Intuition, Graphics, GadTools;
TYPE
feld = ARRAY[1..10] OF TagItem;
VAR
ps : p_Screen; (* Default Public-Screen *)
wp : p_Window; (* Unser Fenster *)
t : feld; (* TagItem-Struktur *)
msg : p_IntuiMessage; (* IntuiMessage (wie b. OS1.3) *)
ydiff,xdiff : INTEGER; (* Für Fontsensitive Positionierung *)
vi : PTR; (* Visual Info *)
gad,gl,StrGad,CheckGad,
CheckGad1,OkGad : p_Gadget; (* Unsere Gadget-Zeiger *)
ng : NewGadget; (* Record zum Ausfüllen *)
ok : BOOLEAN; (* Dummy-Variable *)
buf : STRING[80]; (* Buffer f. Stringgadget *)
KlickG : p_Gadget; (* Angeklicktes Gadget *)
GadNum : CARDINAL; (* Gadgetnummer *)
class : LONG; (* Klasse der Message *)
code : WORD; (* Kode der Message *)
err : LONGINT; (* Zur Textausgabe *)
StrInf : p_StringInfo; (* StringInfo unseres Gadgets *)
BEGIN
{ Buffer initialisieren }
buf := "Bitte etwas eingeben !!";
{ Default PublicScreen locken (i.d.R. der Workbench Screen) }
ps := LockPubScreen(NIL);
{ Haben wir keinen PublicScreen locken können ... }
IF ps = NIL THEN Error("Can`t lock Public Screen !!");
{ VisualInfo holen, sonst keine GadTools-Gadgets ... }
vi := GetVisualInfoA(ps,NIL);
IF vi<>NIL THEN
BEGIN
{ PublicScreen freigeben }
UnLockPubScreen(NIL,ps);
{ Jaaah, wir haben VisualInfo !! }
gad := NIL;
{ Speicherbereich zur Verwaltung von GadTools-Gadgets besorgen }
gad := CreateContext(^gl);
IF gad<>NIL THEN
BEGIN
{ Kontext eingerichtet, es kann losgehen !! }
ydiff := ps^.BarHeight; { Höhe der Titelzeile }
xdiff := ps^.WBorLeft; { Breite des linken Randes }
{ Fontsensitiv !! (Nur was die linke bzw. obere Ecke des
Gadgets betrifft !! }
{ Ausfüllen des Records (wie bei einer Gadget-Struktur: }
ng := NewGadget(xdiff+4,ydiff+4, (* Linke, rechte Ecke *)
250,15, (* Breite, Höhe *)
NIL,NIL, (* Text, TextAttr *)
1,0, (* GadgetNummer, Flags *)
vi,NIL); (* VisualInfo, UserData *)
{ Hinzufügen von optionalen Flags:
GTST_MaxChars: Zeichenlänge
GTST_String: Zeiger auf einen Puffer
( ^---- Wie unter OS1.3 bei StringInfo !! ) }
t[1] := TagItem(GTST_MAXCHARS, 80); { Max. 80 Zeichen }
t[2] := TagItem(GTST_String, LONG(^buf)); { Zeiger auf Buffer }
t[3].ti_Tag := TAG_DONE; { Ende der Liste markieren !! }
{ StrGad erzeugen (Achtung: Keine Abfrage, ob StrGad = NIL !! }
StrGad := CreateGadgetA(STRING_KIND,gad,^ng,^t);
{ PLACETEXT_RIGHT: Text rechts plazieren
PLACETEXT_IN : Text innerhalb plazieren
siehe in libraries/gadtools.h !! }
ng := NewGadget(xdiff+4,ydiff+34,
27,11,
"SUPER",NIL,
2,PLACETEXT_RIGHT,
vi,NIL);
t[1].ti_Tag := TAG_DONE; { Keine speziellen Tag-Zusätze }
CheckGad := CreateGadgetA(CHECKBOX_KIND,StrGad,^ng,^t);
ng := NewGadget(xdiff+4,ydiff+46,
27,11,
"INFORMATIV",NIL,
3,PLACETEXT_RIGHT,
vi,NIL);
CheckGad1 := CreateGadgetA(CHECKBOX_KIND,CheckGad,^ng,^t);
ng := NewGadget(xdiff+4,ydiff+60,
200,13,
"_BEENDEN",NIL,
4,PLACETEXT_IN,
vi,NIL);
{ Der Buchstabe nach dem Unterstrich wird markiert. }
t[1] := TagItem(GT_UNDERSCORE, LONG("_"));
t[2].ti_Tag := TAG_END;
OkGad := CreateGadgetA(BUTTON_KIND,CheckGad1,^ng,^t);
{ ***** Window öffnen ***** }
{ Innere Breite OHNE (!) Rand }
t[1] := TagItem(WA_InnerWidth, 350);
{ Innere Höhe OHNE (!) Rand }
t[2] := TagItem(WA_InnerHeight, 150);
t[3].ti_Tag := WA_Title;
t[3].ti_Data := "GadTools-Beispiel by BOMBERSOFT";
t[4] := TagItem(WA_Flags,WFLG_ACTIVATE+WFLG_DEPTHGADGET+WFLG_CLOSEGADGET);
t[5] := TagItem(WA_IDCMP, IDCMP_CLOSEWINDOW+IDCMP_GADGETUP+IDCMP_VANILLAKEY);
t[6] := TagItem(WA_Gadgets, LONG(gl));
t[7].ti_Tag := TAG_DONE;
wp := OpenWindowTagList(NIL,^t);
IF wp<>NIL THEN
BEGIN
Move(wp^.RPort,xdiff+4,ydiff+29);
err := _Text(Wp^.RPort,"Wie findest Du die Purity ?",27);
ok := FALSE;
REPEAT
{ WaitPort wie unter OS1.3 }
msg := p_IntuiMessage(WaitPort(wp^.UserPort));
{ GT_GetIMsg: Spezielle Funktion von GadTools für die
Gadget-Abfrage: UNBEDINGT mit GT_ReplyIMsg replyen !!!! }
msg := GT_GetIMsg(wp^.UserPort);
class := msg^.Class;
code := msg^.Code;
IF class IN [IDCMP_GADGETUP,IDCMP_GADGETDOWN] THEN
BEGIN
KlickG := msg^.IAddress;
GadNum := KlickG^.GadgetID;
END;
GT_ReplyIMsg(msg);
CASE class OF
IDCMP_CLOSEWINDOW : ok := TRUE;
IDCMP_VANILLAKEY:
CASE code OF
66, 98 : ok := TRUE; { b, B }
ELSE END;
IDCMP_GADGETUP:
CASE GadNum OF
4 : ok := TRUE;
ELSE END;
ELSE END;
UNTIL ok;
CloseWindow(wp);
Writeln("Ergebnis:");
Writeln;
Write("Die Purity ist SUPER: ");
IF (CheckGad^.Flags AND SELECTED)<>0 THEN Writeln("JA !!")
ELSE Writeln("NEIN !!");
Write("Die Purity ist INFORMATIV: ");
IF (CheckGad1^.Flags AND SELECTED)<>0 THEN Writeln("JA !!")
ELSE Writeln("NEIN !!");
Writeln;
StrInf := p_StringInfo(StrGad^.SpecialInfo);
buf := StrInf^.Buffer;
Writeln("Text im String-Gadget:");
Writeln(buf);
END ELSE Writeln("No Window !!");
FreeGadgets(gad); { Gadgets freigeben }
END ELSE Writeln("Couldn`t create Context !!");
FreeVisualInfo(vi); { VisualInfo freigeben }
END ELSE
BEGIN
Writeln("Couldn`t get VisualInfo !!");
END;
END.